COMMENT ⊗   VALID 00024 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	   -*-MIDAS-*-
C00005 00003
C00008 00004
C00011 00005
C00014 00006
C00016 00007
C00024 00008
C00027 00009	IFN D10,[
C00028 00010
C00029 00011
C00032 00012
C00034 00013
C00035 00014
C00038 00015
C00041 00016
C00043 00017
C00054 00018
C00056 00019
C00058 00020
C00059 00021
C00061 00022
C00066 00023
C00067 00024
C00071 ENDMK
C⊗;
;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** INITIALIZATION AND ALLOCATION ROUTINES **
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1980 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************


CONSTANTS	;LITERALS USED PREVIOUSLY MUST BE OUT OF BPS

SUBTTL	INITIALIZATION CODE

;;; THIS CODE IS IN BINARY PROGRAM SPACE

.CRFOFF
OBTL:	REPEAT KNOB, CONC OB,\.RPCNT
.CRFON

INITIALIZE:
IFN D10*HISEGMENT,[
	SETZ FREEAC,
	SETUWP FREEAC,		;FREEAC HAS OLD STATE OF HISEG-PURE BIT
	 .VALUE
]		;END OF IFN D10
IFN D10*PAGING,[
	MOVEI FREEAC,MEMORY-1
	HRRM FREEAC,.JBFF
	CORE FREEAC,
	 .VALUE
IFN SAIL,[
	HRRZ FREEAC,.JBSA	;SET DDT STARTING ADDRESS SO SAVE COMMAND WINS
	SKIPN .JBDDT
	 SETDDT FREEAC,
]	;END IFN SAIL
]	;END IFN D10*PAGING
IFN ITS,[
	MOVE TT,[4400,,400000+<<PDLORG←-PAGLOG>←11>]
	.CBLK TT,
	 .VALUE
	MOVE TT,[4400,,400000+<<SPDLORG←-PAGLOG>←11>]
	.CBLK TT,
	 .VALUE
	MOVE TT,[4400,,400000+<<FXPORG←-PAGLOG>←11>]
	.CBLK TT,
	 .VALUE
]		;END OF IFN ITS
	MOVE P,[-LFAKP-1,,FAKP-1]
	MOVE FXP,[-LFAKFXP-1,,FAKFXP-1]

;;; FALLS THROUGH


SUBTTL DUMP OUT TOPS20 SYMBOL TABLE

IFN D20,[
	MOVE C,[LVRNO]
	SETZ A,
INIT2A:	SETZ B,
	LSHC B,6
	JUMPE B,INIT2B
	IMULI A,10.
	ADDI A,-'0(B)
	JRST INIT2A
INIT2B:	LSH A,30	
	MOVEM A,ENTVEC+2	;VERSION NUMBER STORED IN LOC 137 AS 0XXX00,,
	SKIPN <.JBSYM==:116>		;CHECK FOR SYMBOL TABLE
	 JRST INIT2X			; 
	LDB D,[3014←30 ENTVEC+2]
	MOVEI 1,(D)
	HRLI 1,(GJ%SHT+GJ%OLD)
	MOVE B,INIT2P
	GTJFN	
	 JRST INIT2F
	HRLI 1,(DF%EXP)
	DELF
	 JRST INIT2E
INIT2F:	MOVEI 1,(D)
	HRLI 1,(GJ%SHT+GJ%NEW)
	MOVE B,INIT2P
	GTJFN	
	 JRST INIT2E
	MOVE TT,1		;REMEMBER THE FILE HANDLE FOR LATER USE
	MOVE 2,[<44←36>+OF%WR]	;36 BIT BYTES, WRITE ACCESS
	OPENF
	 JRST INIT2E
	HRRZ 1,TT		;RESTORE JFN
	MOVE 2,.JBSYM		;OUTPUT THE SYMBOL TABLE POINTER
	BOUT			;OUTPUT THE AOBJN POINTER FIRST
	HRRZ 1,TT		;RESTORE JFN
	HRRZ 2,.JBSYM		;SYMBOL TABLE ADDRESS MINUS ONE
	HRLI 2,444400		;36 BIT BYTES
	HLRE 3,.JBSYM		;GET NEGATIVE LENGTH OF SYMBOL TABLE
	SOUT			;OUTPUT THE SYMBOL TABLE TO THE FILE
	CLOSF
	 JRST INIT2E
	HRROI 1,[ASCIZ \;Symbol table dumped out in PS:<MACLISP>LISP.SYMBOLS.\]
	PSOUT
	SETZ T,
	JUMPE D,.+5
	 IDIVI D,10.
	 ADDI D+1,"0
	 PUSH FXP,D+1
	 AOJA T,.-4
	POP FXP,1
	PBOUT 
	SOJN T,.-2
	HRROI 1,[ASCIZ \
\]
	PSOUT
	JRST INIT2X

INIT2P:	440700,,[ASCIZ \PS:<MACLISP>LISP.SYMBOLS\]
INIT2E:	HRROI 1,[ASCIZ \I/O Loses badly while trying to dump symbol table
\]
	PSOUT
	HALTF
]		;END OF IFN D20

INIT2X:	

;;; FALLS IN

INIBS:	MOVEI F,0		;BUBBLE-SORT THE LAPFIV TABLE, WHILE
	MOVEI C,LLSYMS-1	;SORTING THE BSP TABLE AS SUBSIDIARY RECORDS
INIBS1:	MOVE D,LAPFIV(C)
	CAML D,LAPFIV-1(C)
	JRST INIBS2
	MOVEI F,1		;FLAG TO NOTE THAT A BUBBLING OCCURED THIS PASS
	EXCH D,LAPFIV-1(C)
	MOVEM D,LAPFIV(C)	;INTERCHANGE KEYS
	MOVE D,INIBSP(C)
	EXCH D,INIBSP-1(C)	;INTERCHANGE RECORDS
	MOVEM D,INIBSP(C)
INIBS2:	SOJG C,INIBS1
	JUMPN F,INIBS
	MOVNI C,LLSYMS-1
	MOVE AR2A,[441100,,LAP5P]
	MOVE TT,INIBSP+LLSYMS-1(C)
	IDPB TT,AR2A
	AOJLE C,.-2


;;; INITIALIZE THE SEGMENT-LINK COUNTERS FOR ITS & D20

IFN PAGING,[
IRP A,,[FS,FX,FL,SY,SA,S2]B,,[IFS,IFX,IFL,SYM,SAR,IS2]
	MOVEI T,L!B!SG
	MOVEM T,A!SGLK
TERMIN
BG$	MOVEI T,LBNSG
BG$	MOVEM T,BNSGLK
IRPC Q,,[AB]
IFN NXX!Q!SG,[
	MOVE T,IMSGLK
	MOVE TT,[-NXX!Q!SG,,BXX!Q!SG←-SEGLOG]
	DPB T,[SEGBYT,,GCST(TT)]
	MOVEI T,(TT)
	AOBJN TT,.-2
	MOVEM T,IMSGLK
]		;END OF IFN NXX!Q!SG
TERMIN
	MOVEI T,<<<ENDLISP+PAGSIZ-1>&PAGMSK>-BBPSSG>←-PAGLOG
	MOVEI D,BBPSSG←-PAGLOG
	ROT D,-4
	ADDI D,(D)
	ROT D,-1
	TLC D,770000
	ADD D,[450200,,PURTBL]
	MOVEI TT,3
INIT5:	TLNN D,730000
	TLZ D,770000
	IDPB TT,D
	SOJG T,INIT5
	MOVE T,[-<<<<ENDLISP+PAGSIZ-1>&PAGMSK>-BBPSSG>←-SEGLOG>,,ST+<BBPSSG←-SEGLOG>]
	MOVE TT,[$XM,,QRANDOM]
	MOVEM TT,(T)
	AOBJN T,.-1
]	;END OF IFN PAGING

IFE PAGING,[

;;; INITIALIZE THE SEGMENT TABLES, AND LINK COUNTERS FOR DEC-10 

    BZERSG==FIRSTLOC	;CROCK - BEWARE RELOCATION!
    BSYSSG==HILOC

IN10ST:	SETZ A,			;INIBD SETS NON-ZERO ON ERROR
	MOVEI T,FIRSTLOC
	MOVEI TT,FIRSTLOC	;DO NOT ATTEMPT TO PERFORM
	SUBI TT,STDLO		; THIS ARITHMETIC AT ASSEMBLY
	JSP F,INIBD		; TIME! WOULD USE WRONG
	   ASCIZ \LOW\		; RELOCATION QUANTITIES
IFN HISEGMENT,[
	MOVEI T,HILOC
	MOVEI TT,HILOC
	SUBI TT,STDHI
	MOVEM TT,MAXNXM
	SOS MAXNXM
	JSP F,INIBD
	   ASCIZ \HIGH\
	SKIPE A
	 EXIT			;LOSE LOSE
]	;END IFN HISEGMENT
HS%	MOVEI TT,-1
HS%	MOVEM TT,MAXNXM		;AS MUCH CORE AS IT WANTS TO USE!
	MOVE T,[$NXM,,QRANDOM]	;INITIALIZE SEGMENT TABLES
	MOVEM T,ST
	MOVE T,[ST,,ST+1]
	BLT T,ST+NSEGS-1
	SETZM GCST
	MOVE T,[GCST,,GCST+1]
	BLT T,GCST+NSEGS-1
	MOVEI AR1,BTBLKS		;AR1 ACTS AS BTB. [BIT-BLOCK COUNTER]
	LSH AR1,5-SEGLOG
	10ST ZER
	10ST ST
	10ST SAR,[SA,,QARRAY][GCBMRK+GCBSAR]SASGLK
	10ST VC,[LS+VC,,QLIST][GCBMRK+GCBVC]
	10ST IS2,,,S2SGLK
	10ST SYM,[SY,,QSYMBOL][GCBMRK+GCBSYM]SYSGLK
	10ST IFS,[LS+$FS,,QLIST][GCBMRK+GCBCDR+GCBCAR]FSSGLK,BITS
	10ST IFX,[FX,,QFIXNUM][GCBMRK]FXSGLK,BITS
	10ST IFL,[FL,,QFLONUM][GCBMRK]FLSGLK,BITS
BG$	10ST BN,[BN,,QBIGNUM][GCBMRK+GCBCDR]BNSGLK,BITS
	10ST BIT
	10ST FXP,[FX+$PDLNM,,QFIXNUM]
	10ST FLP,[FL+$PDLNM,,QFLONUM]
	10ST P
	10ST SP
	10ST BPS

	10ST SYS,[$XM+PUR,,QRANDOM]
	10ST SY2
	10ST PFS,[LS+$FS+PUR,,QLIST]
	10ST PFX,[FX+PUR,,QFIXNUM]
	10ST PFL,[FL+PUR,,QFLONUM]

IN10S5:	HRRM AR1,BTBAOB
	LSH AR1,SEGLOG-5
	CAIN AR1,BFBTBS
	 JRST IN10S8
	OUTSTR [ASCIZ \LOST WHILE INITIALIZING BIT BLOCKS
\]
	EXIT 1,
IN10S8:

EXPUNGE BZERSG BSYSSG

]		;END OF IFE PAGING



ININTR:	MOVE A,[-KNOB+1-10,,OBTFS+1]	;SET UP OBLIST-LINKING CONSING AREAS
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVEI F,OBTFS
	MOVEM F,FFS
	MOVE F,[-KNOB,,OBTL]
	HRRZ A,(F)
	PUSHJ P,INTERN
	AOBJN F,.-2

INIRND:	JSP F,IRAND		;INITIALIZE RANDOM NUMBER GENERATOR

;INITIALIZE INTERRUPT MASKS IN MEMORY
10$	MOVE T,[STDMSK]
10%	MOVE T,[DBGMSK]
	MOVEM T,IMASK
IFN ITS,[
	MOVE T,[DBGMS2]
	MOVEM T,IMASK2
  	MOVE A,[SETO AR1,]
	MOVEM A,PURIFY
	.BREAK 12,[..SSTA,,[LISPGO]]		;SET START ADDRESS
  	.CORE <ENDLISP+PAGSIZ-1>←-PAGLOG	;FLUSH PDL PAGES
	 .VALUE
	.VALUE [ASCIZ \:≠INITIALIZED≠
\]
	MOVE A,[JRST BINIT9]			;CLOBBER INIT, SINCE ONLY 
	MOVEM A,INITIALIZE			; NEED DO ONCE
BINIT9:	.VALUE [ASCIZ \:≠ALREADY INITIALIZED≠
\]
	JRST BINIT9
]		;END OF IFN ITS
IFN D20,[
	MOVEI 1,.FHSLF
	MOVE 2,[3,,ENTVEC]
	SEVEC
	SKIPN PSYSP
	 JRST .+3
	  PUSHJ P,PURIFY			;If we Purify the SYStem Pages
	  SETZM .JBSYM				; then that flushs the symtab
	MOVE A,[JRST BINIT9]			;CLOBBER INIT, SINCE ONLY 
	MOVEM A,INITIALIZE			; NEED DO ONCE
	HRROI 1,[ASCIZ \;Initialization Done
\]
	SKIPA
BINIT9:	HRROI 1,[ASCIZ \;Already initialized
\]
	PSOUT
	HALTF			;RETURN TO SUPERIOR
	JRST BINIT9
]		;END IFN D20


IFN D10,[
	MACROLOOP N2DIF,ZZD,*
IFE SAIL,[
	OPEN TMPC,INITO1	;CHECK TO SEE IF THERE IS A 
	 JRST INIT1Z		; "LISP:" DEVICE WHICH
	LOOKUP TMPC,INIT1Q	; SHOULD HAVE "DEFMAX.FAS" ON IT
	 JRST INIT1Z
	MOVEI T,QLISP 		;"LISP" IS THUS THE LISP SYSTEM DEVICE
	MOVEI TT,NIL		; AND NEEDS NO PPN PROPERTY
	JRST INIT1W

INIT1Z:	OPEN TMPC,INITO2	;CHECK FOR A "LSP:" DEVICE
	 JRST INIT1A
	LOOKUP TMPC,INIT1Q
	 JRST INIT1A
	MOVEI T,QLSP
	MOVEI TT,IRACOM
INIT1W:	CLOSE TMPC,
	HRLM T,IRACOM		;PUT THE RIGHT "DEVICE" IN THE AUTOLOAD THING
	HRLM TT,INIT1Y		;FIX UP THE "PPN" PROPERTY OF "LISP"
	JRST INIT1X		;BY RPLACD'ING IN THE NEW PPN PROPERTY

INIT1E:	JFCL
	OUTSTR [ASCIZ \
Error in scanning PPN, or PPN is not the LISP sys area -  try again.
\]
INIT1A:	JSP T,D10SET
	OUTSTR [ASCIZ \What is the PPN of the area with the autoload files?  \]
	SETZM PNBUF
	MOVE T,[PNBUF,,PNBUF+1]
	BLT T,PNBUF+LPNBUF-1
	MOVE R,[440700,,PNBUF]
	SETZB TT,D		;NUMBER WORDS - BASE 8 AND BASE 10.
	SETZB F,T		;FLAGS WORD
				; 1 PROJ NUM FOUND
				; 2 PROG NUM FOUND
				; 4 CMU STYLE
				; 10 "[" ENCOUNTERED
				; 20 "]" ENCOUNTERED
				; 40 "." ENCOUNTERED DURING NUMBER
				; 400000,,  ANY DIGITS/CMU-STRING FOUND
INIT1B:	INCHWL A
	CAIE A,↑C
	CAIN A,↑M
	 JRST INIT1C		;↑C OR <CR> TERMINATES PROGRAMMER NUMBER
	TRNE F,20
	 JSP T,INIT1E		;NO MORE CHARS PERMITTED AFTER RB
	CAIE A,91.		;LB FOUND
	 JRST INIT1M
	  TLNE F,400000
	   JSP T,INIT1E
	  TROE F,10
	   TLO F,400000		;PERMIT BRACKETS, BUT NOT REQUIRED
	  JRST INIT1B
INIT1M:	CAIE A,93.		;RB FOUND
	  JRST .+3
	 TRO F,20
	 JRST INIT1B
	SKIPE CMUP
	 TRNN F,4
	  JRST INIT1K
INIT1J:	CAIL A,"a
	 CAILE A,"z
	  JRST .+2
	 SUBI A,"a-"A
	 TLO F,400000
	 IDPB A,R		;ACCUMULATING CMU STYLE INTO PNBUF
	 JRST INIT1B
INIT1K:	CAIE A,".
	 JRST INIT1F
	  TLNE F,400000		;"."
	   TROE F,40
	    JSP T,INIT1E
	  JRST INIT1B
INIT1F:	CAIL A,"0
	 CAILE A,"9
	  JRST INIT1G
	   TLO F,400000
	   IMULI TT,8		;ACCUMULATE NUMBER BASE 8
	   IMULI D,10.		; AND BASE 10.
	   ADDI TT,-"0(A)
	   ADDI D,-"0(A)
	   JRST INIT1B
INIT1G:	CAIE A,",
	 JRST INIT1H
	 TLZE F,400000		;BETTER BE SOME DIGITS
	  TROE F,1		;CANT HAVE TWO COMMAS
	   JSP T,INIT1E
	 TRZE F,40		;PROJ NUMBER FOUND
	  MOVE TT,D		;BASE 10.?
	 MOVEM TT,IPPN1
	 SETZB TT,D
	 JRST INIT1B

INIT1H:	SKIPN CMUP		;NEITHER DIGITS NOR SYNTAX CHARS
	 JSP T,INIT1E
	CAIL A,"a
	 CAILE A,"z
	  JRST .+2
	 SUBI A,"a-"A
	CAIL A,"A
	 CAILE A,"Z
	  JSP T,INIT1E
	TRO F,4
	JRST INIT1J

INIT1D:	MOVEI T,PNBUF
	SKIPE CMUP		;0,,ADDRESS OF CMU PPN STRING
	 CMUDEC T,		;CMUDEC WILL CONVERT A STRING TO A PPN WORD
	  JSP T,INIT1E		;FAIL IF NOT A VALID CMU PPN
	HLRZM T,IPPN1
	HRRZM T,IPPN2
	JRST INIT1V

INIT1C:	TLNN F,400000		;BETTER BE SOME DIGITS
	 JSP T,INIT1E	
	TRNE F,4
	 JRST INIT1D
	TRZE F,40		;PROGRAMMER NUMBER FOUND?
	 MOVE TT,D		;BASE 10.?
	MOVEM TT,IPPN2
INIT1V:	MOVE T,IPPN1
	HRLM T,INIT1S+3		;CHECK TO SEE IF THAT PPN EXISTS
	MOVE T,IPPN2
	HRRM T,INIT1S+3
	RELEASE TMPC,
	OPEN TMPC,INITO3
	 JSP T,INIT1E
INIT1X:	RELEASE TMPC,
]	;END OF IFE SAIL

	MOVE C,[LVRNO]
	SETZ A,
INIT2A:	SETZ B,
	LSHC B,6
	JUMPE B,INIT2B
	IMULI A,10.
	ADDI A,-'0(B)
	JRST INIT2A
INIT2B:	LSH A,30		;VERSION NUMBER STORED IN LOC 137 AS

	MOVEM A,137		;0XXX00,,0
	MOVEI A,LISPGO
	HRRM A,.JBSA"
	MOVEM A,INIT
;SA$	MOVEI FREEAC,1	;SAIL SETUWP DOES NOT RETURN OLD VALUE IN AC AS DEC10
HS$ SA%	SETUWP FREEAC,	;RESTORE WRITE PROTECT STATUS
HS$ SA%	.VALUE
IFE SAIL,[
	OUTSTR [ASCIZ \:$INITIALIZED$
\]
	EXIT 1,
]		;END OF IFE SAIL
IFN SAIL,[
IFN HISEGMENT,[
	SETZ T,
	GETNAM T,
	MOVEM T, SGANAM
;	 JRST INIT7B
	PUSHJ P,SAVHGH		;SAVE HIGH SEGMENT AS SYS:MACLSP.SHR
	 JRST INIT7A
	OUTSTR [ASCIZ \:$INITIALIZED; HIGH SEGMENT SAVED$
\]
	SETZ T,			;RECALL THAT A CRUFTY CODE 15 MAKES PTLOAD HAPPY
	MOVE TT,[440700,,[ASCIZ \SAVE SYS:MACLSP
\]]
	PTLOAD T		;STICK SAVE COMMAND IN LINE EDITOR
	MOVEI T,INIT99
	HRRM T,RETHGH
	JRST KILHGH		;FLUSH HIGH SEGMENT

INIT7A:	OUTSTR [ASCIZ \:$FAILED TO SAVE HIGH SEGMENT$
\]
INIT7B:	OUTSTR [ASCIZ \:$INITIALIZED$
\]
	SETZ T,			;RECALL THAT A CRUFTY CODE 15 MAKES PTLOAD HAPPY
	MOVE TT,[440700,,[ASCIZ \SSAVE SYS:MACLSP
\]]
	PTLOAD T		;STICK SAVE COMMAND IN LINE EDITOR
	EXIT 1,
]	;END IFN HISEGMENT

IFE HISEGMENT,[
	OUTSTR [ASCIZ \:$INITIALIZED$
\]
	EXIT 1,
	JRST @.JBSA
]	;END IFE HISEGMENT
]	;END OF IFN SAIL
]	;END OF IFN D10

INIT99:	JRST LISPGO

IFN D10,[
INITO1:	.IOBIN 
	SIXBIT \LISP\ 
	0
INITO2:	.IOBIN 
	SIXBIT \LSP\ 
	0
INITO3:	.IOBIN
	SIXBIT \DSK\
	0		

INIT1Q:	SIXBIT \DEFMAX\ 
	SIXBIT \FAS\ 
	0
	0
INIT1S:	SIXBIT \DEFMAX\ 
	SIXBIT \FAS\ 
	0
	0 			;FILLED IN WITH ippn1,,ippn2
]	;END OF IFN D10


;;; NOTE THAT THE SECOND $ IN THE MESSAGE HERE IS A REAL DOLLAR SIGN,
;;; WHILE THE OTHER TWO ARE ALTMODES; THUS DDT WON'T GET SCREWED!

NOTINIT:
IFN ITS,[
	 .VALUE [ASCIZ \:≠LISP NOT INITIALIZED (USE INIT$G)≠
\]
]		;END OF IFN ITS
IFN D20,[ 
	HRROI 1,[ASCIZ \;Not INITIALIZED (use INIT$G)≠
\]
	PSOUT
	HALTF
]	;END OF IFN D20

INIBSP:	REPEAT LLSYMS, .RPCNT

IFN D10,[

;;; ROUTINE TO CHECK SEGMENT BOUNDARIES, AND IF LOSING,
;;; TELL LOSER HOW TO WIN WITH LINK-10.

INIBD:	TRNN TT,SEGKSM
	 JRST 1(F)		;WIN
	SETO A,
	OUTSTR (F)
	OUTSTR [ASCIZ \ SEGMENT ON BAD BOUNDARY. TELL LINK "/SET:.\]
	OUTSTR (F)
	OUTSTR [ASCIZ \.:\]
	ANDI TT,SEGKSM
	ADDI T,SEGSIZ
	SUBI T,(TT)
	HRLZ TT,T
	MOVEI D,6
INIBD1:	SETZ T,
	LSHC T,3
	ADDI T,"0
	OUTCHR T
	SOJG D,INIBD1
	OUTSTR [ASCIZ \"
\]
	JRST 1(F)

]		;END OF IFN D10

IFN ITS,[
IFE SEGLOG-11,[		;VARIOUS PARAMETERS BUILT INTO UCODE
IFLE HNKLOG-5,[

;;; KL-10 INIT ROUTINE

KLINIT:	MOVE T,[-NSEGS,,GCST]
KLINI1:	MOVE TT,(T)
IFN HNKLOG,	TLNN TT,GCBFOO+GCBHNK
.ELSE		TLNN TT,GCBFOO
	 JRST KLINI2
	SETO D,
	TLNE TT,GCBSYM
	 MOVEI D,0
	TLNE TT,GCBVC
	 MOVEI D,1
	TLNE TT,GCBSAR
	 MOVEI D,2
IFN HNKLOG,[
	HRRZ R,ST(T)
	TLNE TT,GCBHNK
    2DIF [MOVEI D,(R)]3,QHUNK1
]		;END OF IFN HNKLOG
	SKIPGE D
	 .VALUE
IFN HNKLOG,	TLZ TT,GCBFOO+GCBHNK
.ELSE		TLZ TT,GCBFOO
	TLO TT,200000
	DPB D,[330300,,TT]
	MOVEM TT,(T)
KLINI2:	AOBJN T,KLINI1
	MOVE T,[JRST KLGCM1]
	MOVEM T,GCMRK0
	MOVE T,[JRST KLGCSW]
	MOVEM T,GCSWP
	.VALUE [ASCIZ \:≠INITIALIZED FOR KL-10≠
\]

]		;END OF IFLE HNKLOG-5
]		;END OF IFE SEGLOG-11
]		;END OF IFN ITS
IFN D10,[
LOPDL==200
LOFXPDL==100
LOSPDL==40
LOFLPDL==10
ALBPS==7000
SA$ ALBPS==ALBPS+4000
]		;END OF IFN D10

SUBTTL	HAIRY ALLHACK MACRO

DEFINE AMASC A,B
	ASCIZ \
A!B	\
TERMIN

DEFINE ALLHACK XLABEL,TP,NAME,STDALC,MINALC,EXTRA,WHERE,NWHERE
	SKIPE ALLF
	JRST XLABEL
	PUSHJ P,ALLTYO
	AMASC [TP! !NAME = ]\STDALC
	MOVE AR1,[ASCII \NAME\]
	PUSHJ P,ALLNUM
	SKIPGE A
XLABEL:	MOVEI A,STDALC
	CAIGE A,MINALC
	MOVEI A,MINALC
IFSN EXTRA,,	ADDI A,EXTRA
	HRRM A,WHERE
IFSN NWHERE,,[
	MOVN B,A
	HRRM B,NWHERE
]
	PUSHJ P,ALLECO
TERMIN

SUBTTL	ALLOC I/O ROUTINES

10% ALLJCL:	BLOCK 80.	;BUFFER UP JOB COMMAND LINE IF THERE WAS ONE.
10% ALJCLP:	-1	;ALLOW ONLY ONE TRY FOR JCL (JOB COMMAND LINE)
FAKJCL:	0	;NON-ZERO MEANS LOOKING FOR INIT FILE, 0 MEANS JCL FILE
ALLF:	0	;NON-ZERO FOR STANDARD ALLOCATION
AINFIL:	0	;NON-NIL MEANS LOAD .LISP. (INIT) FILE AFTER ALLOCING
ATYF:	0	;TTYOFF FOR ALLOC
LICACR:	0	;LAST INPUTED CHAR TO ALLOC WAS A CR   -1 ==> YES
ALERR:	STRT [SIXBIT \GC CALLED FROM ALLOC - LOSE, LISP IS DEAD!\]
	.VALUE


;;;	PUSHJ P,ALLTYO		;PRINT ASCIZ STRING FOR ALLOC
;;;	   ASCIZ \TEXT...\	;NOTE: ASCIZ IS NOT IN [ ... ] !

ALLTYO:	HRLI A,440700
	HLLM A,(P)
ATYOI:	ILDB A,(P)
	JUMPE A,POPJ1
	SKIPN ATYF
	PUSHJ P,ALLTYC
	JRST ATYOI

ALLECO:	SKIPL AFILRD
	SKIPE ATYF
	POPJ P,
	PUSH P,A
	MOVE TT,A
	HRROI R,TYO
	PUSHJ P,PRINL4
	POP P,A
	POPJ P,
IFN SAIL,[
SAILP4:	CAIN C,32		;A TILDE?
	JRST SAIP1
	CAIN C,176		;A }
	JRST SAIP2
	CAIE C,175		;AN ALTMODE
	JRST SAIP3
	MOVEI C,33
	JRST SAIP3
SAIP1:	MOVEI C,176
	JRST SAIP3
SAIP2:	MOVEI C,175
SAIP3:	TRZE C,600	;CTRL/META/BOTH?
	TRZ C,140
	CAIN C,121
	MOVEI C,21
	CAIN C,161
	MOVEI C,21
	CAIN C,127
	MOVEI C,27
	CAIN C,167
	MOVEI C,27
	POPJ P,
]	;END OF IFN SAIL

ALLTYI:
IFN ITS,[
	.IOT 0,C		;CHANNEL NUMBER FILLED IN
]	;END OF IFN ITS
IFN D10,[
	INCHRW C
SA$	PUSHJ P,SAILP4
	AOSG LICACR
	 JRST ATI1
ATI2:	CAIN C,↑M
	SETOM LICACR
]	;END OF IFN D10
IFN D20,[
	PUSH P,1
	PBIN
	MOVEI C,(1)
	POP P,1
]		;END IFN D20
	CAIN C,↑G
	 JRST ALLOC1
	POPJ P,

IFN D10,[
ATI1:	CAIN C,↑J		;FLUSH A SYSTEM-SUPPLIED LINE-FEED
	INCHRW C		;FOLLOWING A CR
SA$	PUSHJ P,SAILP4
	JRST ATI2
]	;END OF IFN D10

ALLTYC:
IFN ITS,[
	CAIE A,↑J
 ALOIOT:
	.IOT 0,A		;WILL CLOBBER CHANNEL HERE
]	;END OF IFN ITS
10$	OUTCHR A
20$	PBOUT			;OUTPUT TO PRIMARY OUTPUT JFN
	POPJ P,

ALLRUB:	PUSHJ P,ALLTYO
	ASCIZ \XX
\
ALLNUM:	SKIPGE C,AFILRD	;GETS A NUMBER FOR SOME STORAGE AREA SIZE
	JRST ALNM1
ALNM2:	JUMPN C,ALNM27
	SETO A,
	POPJ P,
ALNM27:	HLRZ A,(C)	;SEARCH THE READ IN LIST TO SEE
	HRRZ C,(C)	;WHETHER LOSER HAS TRIED TO SPECIFY
	JUMPE C,ALLNER	;ALLOCATION FOR THIS QUANTITY
  	SKOTT A,SY
	 JRST ALSYER
  	HLRZ A,(A)
  	HRRZ A,1(A)
	HLRZ AR2A,(A)
	HLRZ A,(C)
	CAMN AR1,(AR2A)
	 JRST ALNM3
	HRRZ C,(C)
	JRST ALNM2

ALNM3:	MOVE TT,(A)		;GET NUMBER INTO TT
	SKOTT A,FL		;IF FLOATING CONVERT TO FIXNUM
	 SKIPA
	  PUSHJ P,FIX2
  	SKOTT A,FX		;IS IT FIXNUM?
	 JRST ALNMER
ALNMOK:	MOVE A,(A)
	POPJ P,

ALSYER:	MOVEI D,[SIXBIT \NON-SYMBOL ALLOCATION AREA!\]
	JRST ALCLZ1

ALNMER:	MOVEI D,[SIXBIT \NON-FIXNUM/FLONUM ALLOCATION QUANTITY!\]
	JRST ALCLZ1

ALLNER:	MOVEI D,[SIXBIT \ODD LENGTH ALLOCATION COMMENT!\]
	JRST ALCLZ1

ALNM1:	MOVSI B,400000
	MOVSI A,400000	;GET VALUE FROM TTY
ALNM1A:	PUSHJ P,ALLTYI
	CAIE C,12
	CAIN C,15
	POPJ P,
	CAIE C,33	;ALT MODE SAYS "DONE ALLOCING"
	JRST .+3
	SETOM ALLF
	POPJ P,
	CAIN C,".
	MOVE A,B
	MOVE D,RCT0(C)
	TLNE D,170000
	POPJ P,
	CAIL C,"0
	CAILE C,"9
	JRST ALLRUB
	TLZ A,400000
	TLZ B,400000
	IMULI A,10
	ADDI A,-"0(C)
	IMULI B,10.
	ADDI B,-"0(C)
	JRST ALNM1A

IFN D10,[
DECDIG:	SKIPE ATYF
	POPJ P,
	JUMPN T,DDIG1
	OUTCHR [ASCII \0\]
DDIG1:	JUMPE T,CPOPJ
	IDIVI T,10
	PUSH P,TT
	PUSHJ P,DECDIG
	POP P,TT
	ADDI TT,"0
	OUTCHR TT
	POPJ P,
]		;END OF IFN D10

SUBTTL	ALLOC (INIT) FILE ROUTINES

ALOFIL:

IFN ITS,[
	MOVSI C,(SIXBIT \DSK\)
	.SUSET [.RXUNAME,,A]
	MOVE B,[SIXBIT \LISP\]
	.SUSET [.RHSNAME,,F]
ALOINI:	.CALL ALOFL6		;DOES INIT FILE EXIST?
	 JRST ALOFL2
	JRST ALOIN1		;ELSE PROCEED NORMALLY

ALOFL2:	CAMN A,[SIXBIT /*/]	;ALREADY TRIED **?
	 JRST ALFLER		;YUP, GIVE UP
	MOVE A,@ALOFL2		;ELSE TRY **
	JRST ALOINI

ALOJCL:	.CALL ALOFL6		;DOES JCL FILE EXIST?
	 JRST ALFLER		;NOPE, ERROR
ALOIN1:	MOVEM C,INIIF2+F.DEV	;YES, SAVE FILE NAMES
	MOVEM F,INIIF2+F.SNM
	MOVEM A,INIIF2+F.FN1
	MOVEM B,INIIF2+F.FN2
ALOFL4:	.CLOSE TMPC,
]		;END IFN ITS
IFN D10,[
	HRLZI C+1,(SIXBIT/DSK/)
	MOVE A,[SIXBIT/LISP/]
	HRLZI B,(SIXBIT/INI/)
ALOFL1:	SETZB C,C+2
	OPEN TMPC,C
	 JRST ALFLER		;NO DISK?
	MOVEM C+1,INIIF2+F.DEV
	SETZI C,
	MOVE C+1,R		;GET SPECIFIED PPN
	MOVEM C+1,INIIF2+F.PPN
	LOOKUP TMPC,A
	 JRST ALFLER
	MOVEM A,INIIF2+F.FN1
	HLLZM B,INIIF2+F.FN2
	CLOSE TMPC,
];END IFN D10
IFN D20,[
	SKIPE TENEXP
	 SKIPA C,[ASCIZ \DSK\]
	MOVE C,[ASCIZ \PS\]		;LOSE LOSE - ASSUME CONNECTED TO "PS:"
	MOVEM C,INIIF2+F.DEV		;YES, SAVE FILE NAMES
]		;end of IFN D20
	PUSH P,[ALOFL5]
	PUSH P,[INIIFA]
	PUSH P,[QNODEFAULT]	;DON'T MEREGE WITH DEFAULT FILENAMES
	MOVNI T,2
	JRST $EOPEN		;OPEN INIT FILE ARRAY
ALOFL5:	MOVEM A,VINFILE
	MOVEI A,TRUTH
	MOVEM A,TAPRED
	SETOM AFILRD
	POPJ P,

IFN ITS,[
ALOFL6:	SETZ
	SIXBIT \OPEN\		;OPEN FILE
	  5000,,2		;MODE (ASCII BLOCK INPUT)
	  1000,,TMPC		;CHANNEL #
	      ,,C		;DEVICE
	      ,,A		;FILE NAME 1
	      ,,B		;FILE NAME 2
	400000,,F		;SNAME
];END IFN ITS

;SETUP DEAFULT JCL
IFN D10,[
ALFDEF:	SETOM FAKJCL		;JCL IS REALLY FAKE
	MOVE TT,[ASCII \LISP \]	;DEFAULT JCL: LISP <CR>
	MOVEM TT,SJCLBUF+1
	MOVE TT,[ASCII \
\]
	MOVEM TT,SJCLBUF+2
	POPJ P,
]	;END IFN D10


ALLFIL:	PUSHJ P,ALOFIL		;OPEN INIT FILE
ALLFL1:	SETZM BFPRDP
	PUSHJ P,READ		;READ IN ALLOCATIONS "COMMENT"
	SETZM ALGCF
	HLRZ B,(A)
	CAIE B,Q$COMMENT
	JRST ALCLUZ
ALLFL2:	HRRZ A,(A)
	MOVEM A,AFILRD		;SAVE IT (ACTUALLY, ITS CDR)
	JRST ALLOCC

ALCLUZ:	MOVEI D,[SIXBIT \ALLOC COMMENT MISSING IN INIT FILE!\]
ALCLZ1:	HRRZ A,VINFILE
	SETZM VINFILE
	PUSH FXP,D
	PUSHJ P,$CLOSE
	POP FXP,D
20%	MOVE A,INIIF2+F.FN1
20%	MOVE B,INIIF2+F.FN2
IT$	MOVE F,INIIF2+F.SNM
10$	MOVE F,INIIF2+F.PPN
20$	WARN [WHAT TO DO FOR FILE NOT FOUND ERROR FOR D20 ALLOC]
	SETZM FAKJCL		;FORCE ERROR MESSAGE THROUGH EVEN IF FAKING JCL
	JRST ALCERR

IFN ITS,[
ALLTTS:	SETZ		;TTYSET FOR ALLOC - NO INTERRUPT CHARS!
	SIXBIT \TTYSET\		;SET TTY VARIABLES
	      ,,TTYIF2+F.CHAN	;CHANNEL #
	      ,,[STTYA1]	;TTYST1
	400000,,[STTYA2]
]		;END OF IFN ITS

ALHELP:	PUSHJ P,ALLTYO
	ASCIZ \
N = DON'T ALLOCATE (I.E. USE DEFAULTS)
Y = ALLOC FROM TTY
↑A = READ INIT FILE AND ALLOC FROM IT
↑B = ALLOC FROM TTY, THEN READ INIT FILE
↑W = SAME AS ↑A, BUT NO ECHO ON TTY
ALTMODE, TYPED AT ANY TIME, TERMINATES ALLOCATION PHASE, 
   TAKING REMAINING PARAMETERS AS DEFAULTS.
↑G RESTARTS ALLOC.
LINES PROMPTED BY A "#" CANNOT BE RE-ALLOCATED AFTER RUNNING.
   OTHERS CAN BE RE-ALLOCATED AT ANY TIME
   WITH THE LISP FUNCTION "ALLOC".
TERMINATE EACH NUMERIC ENTRY WITH CR OR SPACE.
A CR OR SPACE TYPED WITHOUT A PRECEDING NUMBER
   ASSUMES THE DEFAULT FOR THAT ENTRY.
RUBOUT RESTARTS THE CURRENT ENTRY.
NUMBERS ARE TYPED IN BASE EIGHT, UNLESS SUFFIXED BY ".",
   IN WHICH CASE BASE TEN IS USED.
ALL ENTRIES ARE IN UNITS OF PDP-10 WORDS.
\
	JRST ALLOC1

ALFLER:	MOVEI D,[SIXBIT \   INIT FILE NOT FOUND!\]
ALCERR:	SETZM TAPRED
	SETZM TTYOFF
	SETZM TAPWRT
	AOSN FAKJCL		;DID WE FAKE JCL?
	 JRST POPJ1		;YUP, THEN SKIP RETURN SO CAN DO ALLOC
	STRT [SIXBIT \    !\]
IFN ITS,[
	MOVE AR1,F
	MOVEI T,";
	PUSHJ P,ALFL6
]		;END OF IFN ITS
	MOVE AR1,A
10%	MOVEI T,40
10$	MOVEI T,".
	PUSHJ P,ALFL6
	MOVE AR1,B
	MOVEI T,40
	PUSHJ P,ALFL6
	STRT (D)
SA$	CLRBFI			;CLEAR INPUT BUFFER FOR SAIL
	MOVNI T,0		;SETUP FOR NO ARG LSUBR CALL
	JRST QUIT		; (VANILLA-FLAVORED QUIT)

ALFL6:	EXCH A,R
	SETZ AR2A,
	MOVE TT,[440600,,AR1]
ALFL6A:	ILDB A,TT
	JUMPE A,ALF6A0
	ADDI A,40
IT$	ALFL6C:	.IOT 0,A		;CHANNEL # FILLED IN
10$	OUTCHR A
20$	PBOUT
	JRST ALFL6A
ALF6A0:	MOVE A,T
IT$	ALFL6B: .IOT 0,A		;CHANNEL # FILLED IN
10$	OUTCHR A
20$ 	PBOUT
	EXCH A,R
	POPJ P,

SUBTTL	MAIN ALLOC INTERACTION CODE

%ALLOC:
IFN D10,[
	SETZM LICACR		;LAST INPUT CHAR TO ALLOC WAS? CR - NO!
IFE SAIL,[
	MOVEM 0,SGANAM		;SAVE MAGIC STUFF FOR GETHGH
	MOVEM 11,SGADEV
	MOVEM 7,SGAPPN
	JSP T,D10SET
]		;END OF IFE SAIL
	MOVEI A,ENDLISP+PAGSIZ-1;MUST DO CRUFTY CALCULATION BY HAND AS INVOLVES
	ANDI A,PAGMSK		;BOOLEAN OPS AND RELOCATABLE SYMBOLS (BARF!!)
	SUBI A,EINIFA
	MOVEM A,IGCFX1
]		;END OF IFN D10
20$	JSP R,TNXSET		;DECIDE BETWEEN TENEX AND TOPS20
				; AND SET PAGE ACCESSIBILITY
	MOVE A,[RCT0,,RCT]
	BLT A,RCT+LRCT-1
IFN ITS,[
	MOVE TT,[4400,,400000+<<PDLORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
	MOVE TT,[4400,,400000+<<SPDLORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
	MOVE TT,[4400,,400000+<<FXPORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
	MOVE TT,[4400,,400000+<<FLPORG←-PAGLOG>←11>]
	.CBLK TT,
	.VALUE
]		;END OF IFN ITS
	MOVE P,C2
	MOVE SP,SC2
	MOVE FXP,FXC2
	MOVE FLP,FLC2
	MOVE A,[-LFSALC+1,,FSALC+1]	;SET UP ALLOC CONSING AREAS
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVE A,[-LFWSALC+1+NIFWAL,,FWSALC+1+NIFWAL]
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVE A,[-LSYALC+1,,SYALC+1]
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVE A,[-NIS2SG*SEGSIZ/2+1,,SY2ALC+2]
	HRRZM A,-2(A)
	ADDI A,1
	AOBJN A,.-2
	MOVE A,[-INFVCS+1,,BFVCS+1]
	HRRZM A,-1(A)
	AOBJN A,.-1
	MOVEI A,FSALC		;SET UP PHONY FREELISTS
	MOVEM A,FFS
	MOVEI A,FWSALC+NIFWAL
	MOVEM A,FFX
  	MOVEI A,SYALC
  	MOVEM A,FFY
	SETOM ALGCF		;ERROR OUT ON GC (UNTIL FURTHER NOTICE)
	SETZB NIL,ATYF
	SETOM AFILRD
IFN ITS,[
	.SUSET [.RSNAM,,T]
	MOVEM T,TTYIF2+F.SNM
	MOVEM T,TTYOF2+F.SNM
]	;END OF IFN ITS
IFN D10,[
SA$	SETZ T,
SA$	DSKPPN T,		;AS SET BY ALIAS COMMAND
SA%	GETPPN T,
	MOVEM T,TTYIF2+F.PPN
	MOVEM T,TTYOF2+F.PPN
SA%	SETZ T,
]	;END OF IFN D10
IFE D20,[
	PUSH FXP,[SIXBIT \DSK\]
	PUSH FXP,T
	PUSH FXP, [SIXBIT \*\]
IT$ 	PUSH FXP,[SIXBIT \>\]
10$ SA% 	PUSH FXP,[SIXBIT \LSP\]
SA$	PUSH FXP, [SIXBIT \←←←\]
]		;END IFE D20
IFN D20,[
	SKIPE TENEXP
	 SKIPA T,[ASCIZ \DSK\]
	MOVE T,[ASCIZ \PS\]		;LOSE LOSE - ASSUME CONNECTED TO "PS:"
	PUSH FXP,T
	PUSHN FXP,L.6DEV-1
	PUSH FXP,[ASCIZ \*\]
	PUSHN FXP,L.6DIR-1
	PUSH FXP,[ASCIZ \*\]
	PUSHN FXP,L.6FNM-1
	PUSH FXP,[ASCIZ\LSP\]
	PUSHN FXP,L.6EXT-1
	PUSH FXP,[ASCIZ \*\]
	PUSHN FXP,L.6VRS-1
]		;END IFN D20
	PUSHJ P,6BTNML
	MOVEM A,VDEFAULTF
	PUSHJ P,OPNTTY		;OPEN TTY INPUT AND OUTPUT
	 .VALUE			;MUST HAVE TTY TO DO ALLOC
IFN ITS,[
	MOVE T,TTYOF2+F.CHAN	;INITIALIZE CHANNEL NUMBER FOR
	DPB T,[270400,,ALOIOT]	; ALLOC'S OUTPUT .IOT TO TTY
	DPB T,[270400,,ALFL6B]
	DPB T,[270400,,ALFL6C]
	MOVE T,TTYIF2+F.CHAN	;NOW DO THE SAME FOR
	DPB T,[270400,,ALLTYI]	; THE INPUT .IOT
]	;END IFN ITS
IFN ITS,[
	AOSE ALJCLP
	 JRST ALJ3
	.SUSET [.ROPTION,,TT]
	SETZM FAKJCL		;NOT FAKE JCL
	TLNE TT,20000		;NOT DDT ABOVE LISP
	 TLZN TT,40000		;IF THERE IS JCL, TURN IT OFF AFTER READING
	  SOSA FAKJCL		;NO JOB COMMAND LINE, FLAG AS FAKE JCL
	.BREAK 12,[..RJCL,,ALLJCL]
ALFDE1:	SETZB A,C
	SETZB D,F
	SETZ B,
	MOVE AR1,[440700,,ALLJCL]
ALJ1:	MOVE AR2A,[440600,,T]
	SETZ T,
ALJ1A:	ILDB TT,AR1
	JUMPE TT,ALJ2
	CAIGE TT,"!
	 JRST ALJ1B
	CAIE TT,":
	 JRST ALJ1A1
	MOVE C,T
	AOJA D,ALJ1

ALJ1A1:	CAIE TT,";
	 JRST ALJ1A2
	MOVE F,T
	AOJA D,ALJ1

ALJ1A2:	CAIL TT,"a	;LOWER-CASE
	 CAILE TT,"z
	  ADDI TT,40
	ANDI TT,77
	TLNE AR2A,770000
	 IDPB TT,AR2A
	JRST ALJ1A

ALJ1B:	JUMPE T,ALJ1B2
	JUMPE A,ALJ1B1
	MOVEM T,B
	JRST ALJ1B2
ALJ1B1:	MOVEM T,A
ALJ1B2:	CAIN TT,33		;ALTMODE MEANS INIT FILE CAN GET JCL
	 JRST ALJ2Q
	CAIE TT,↑M
	 JRST ALJ1
ALJ2:	.SUSET [.ROPTION,,TT]
	TLZ TT,OPTCMD		;TURN OFF JCL
	.SUSET [.SOPTION,,TT]
ALJ2Q:	SKIPN C
	 MOVSI C,(SIXBIT \DSK\)
	JUMPN A,ALJ2A
	SKIPN FAKJCL		;IF JCL FAKED, ALWAYS READ INIT
	 JUMPE D,ALJ3		;IF WAS REALLY NULL THEN DON'T TRY TO READ INIT
	MOVE B,[SIXBIT \LISP\]	;ASSUME FN2 OF LISP
	SKIPN F			;SNAME SPECIFIED?
	 .SUSET [.RHSNAME,,F]	;NOPE, USE THE HSNAME
	.SUSET [.RXUNAME,,A]	;XUNAME IS FIRST TRY AT FN1
	SETOM ATYF		;TURN OF TTY OUTPUT
	PUSHJ P,ALOINI		;TRY TO FIND FILE, USE INIT FILE ALGORITHM
	 JRST ALLFL1		;FILE FOUND
	JRST ALJ2A1
ALJ2A:
	SKIPN F			;DEFAULT SNAME?
	 .SUSET [.RSNAM,,F]
	SKIPN B			;DEFAULT FN2?
	 MOVSI B,(SIXBIT />/)
	SETOM ATYF
	PUSHJ P,ALOJCL
	JRST ALLFL1

ALJ2A1:	SETZM ATYF		;TURN ON TTY I/O
ALJ3:	.CALL ALLTTS
	.VALUE
]		;END OF IFN ITS

IFN D10,[
	SETZM FAKJCL		;NOT FAKE JCL YET
	JSP F,JCLSET
	SKIPN SJCLBUF+1		;ANY JCL?
	 PUSHJ P,ALFDEF		;SETUP DEFAULT JCL
	SETZB D,R		;D IS FLAG FOR . SEEN, R IS PPN
	SETZB A,C
10$	MOVSI B,(SIXBIT \INI\)
20$	MOVE B,[ASCII \INI\]
	MOVE AR1,[440700,,SJCLBUF+1]
ALJ1:	MOVE AR2A,[440600,,T]
	SETZ T,
ALJ1A:	ILDB TT,AR1
	JUMPE TT,ALJ2
	CAIGE TT,"!
	 JRST ALJ1B
	CAIE TT,":
	 JRST ALJ1A1
	MOVE C,T
	JRST ALJ1

ALJ1A1:	CAIE TT,".
	 JRST ALJ1A2
	MOVE A,T
	SETZ B,
	AOJA D,ALJ1

ALJ1A2:	CAIE TT,91.		;START OF PPN SPEC?
	 JRST ALJ1A3
SA%	GETPPN R,		;HOLD PPN IN R
SA%	 JFCL			;IGNORE FUNNY SKIP RETURNS
SA$	SETZ R,
SA$	DSKPPN R,		;ON SAIL USE ALIAS
	PUSHJ P,HAFPPN		;READ 1/2 PPN, SKIP IF ZERO
	 HRL R,T
	CAIE TT,",		;IF TERMINATOR NOT COMMA THEN GIVE UP ON PPN
	 JRST ALPPN1
	PUSHJ P,HAFPPN		;READ THE OTHER HALF OF THE PPN
	 HRR R,T		;REPLACE IN GENERATED PPN
	CAIE TT,95.		;TERMINATING CLOSE BRACKET?
ALPPN1:	 MOVE TT,C+2		;NOPE, RESTORE OLD BYTE POINTER
	JRST ALJ1

ALJ1A3:	CAIL TT,"a		;LOWER CASE
	 CAILE TT,"z
	  ADDI TT,40
	ANDI TT,77
	TLNE AR2A,770000
	 IDPB TT,AR2A
	JRST ALJ1A

ALJ1B:	JUMPE T,ALJ1B2
	SKIPN D
	 SKIPA A,T
	  HLLZ B,T
ALJ1B2:	CAIN TT,33	;ALT-MODE SAYS DONT FLUSH JCL
	 JRST ALJ2Q
	CAIN TT,↑M
	 JRST ALJ1
ALJ2:	SETZM SJCLBUF
ALJ2Q:	SKIPN C+1,C
	 MOVSI C+1,(SIXBIT \DSK\)
	SETOM ATYF
	PUSHJ P,ALOFL1		;SKIP RETURN MEANS INIT FILE NOT FOUND
	 JRST ALLFL1

	SETZM ATYF		;TURN ON TTY I/O
	JRST ALJ3

HAFPPN:	SETZ T,			;START OFF WITH 0
	MOVE C+2,AR1		;SAVE CURRENT BYTE POINTER
	ILDB TT,AR1
	CAIL TT,"0		;MUST BE NUMERIC
	 CAILE TT,"9
	  JRST HAFPP1
	LSH T,3			;ADD DIGIT INTO PPN
	ADDI T,-"0(TT)
	JRST HAFPPN
HAFPP1:	SKIPN T			;SKIP RETURN IF T NIL
	 AOS (P)
	POPJ P,

ALJ3:
]		;END OF IFN D10

IFN D20,[
	HRLZI 1,(GJ%SHT+GJ%OLD)	;SHORT FORM, ONLY OLD FILE
	SKIPE TENEXP
	 SKIPA 2,[-1,,[ASCIZ /DSK:LISP.INI/]]
	HRROI 2,[ASCIZ /PS:LISP.INI/]
	GTJFN
	 JRST ALLCB1		;NO INIT FILE, SO JUST CONTINUE NORMALLY
	RLJFN			;HAVE THE INIT FILE, RETURN THE JFN
	 JFCL
	SETOM ATYF		;NO TYPEOUT
	JRST ALLFIL		;THEN READ AND PROCESS INIT FILE
ALLCB1:	] ;END IFN D20
	PUSHJ P,ALLTYO
	ASCIZ \
LISP \
	MOVE B,[LVRNO]
ALLOCB:	SETZ A,
	LSHC A,6
	JUMPE A,ALLOCA
	ADDI A,40
	PUSHJ P,ALLTYC
	JRST ALLOCB

ALLOCA:
ALLOC1:	PUSHJ P,ALLTYO
	ASCIZ \
Alloc? \
	PUSHJ P,ALLTYI
	SETZM ALLF
	CAIN C,↑W
	SETOM ATYF
	CAIE C,↑W
	 CAIN C,↑A
	  JRST ALLFIL
	CAIE C,33	;ALTMODE
	 CAIN C,40	;SPACE
	  SETOM ALLF
	CAIE C,↑B
	 JRST .+3
	  SETOM AINFIL
	  JRST ALLOCC
	CAIE C,"n	;LOWER CASE
	 CAIN C,"N
	  SETOM ALLF
	SKIPE ALLF
  	 JRST ALLOCC
	CAIE C,"Y
	 CAIN C,"y	;LOWER CASE
	  JRST ALLOCC
	CAIN C,"?
	 JRST ALHELP
	CAIE C,"H
	 CAIN C,"h	;LOWER CASE
	  JRST ALHELP
SA$	BEEP=047000,,400111
SA$	SETOM A
SA$	BEEP A,
SA%	MOVEI A,↑G	;RANDOM ILLEGAL CHARACTER TO ALLOC
SA%	PUSHJ P,ALLTYC
IT$	HRRZ TT,TTYIF2+F.CHAN
IT$	.CALL CKI2I
IT$	 .VALUE
20$	MOVEI 1,.PRIIN
20$	CFIBF
	JRST ALLOC1


IFN PAGING,[
ALCORX==<BBPSSG-SEGSIZ*<NIFSSG+NIFXSG+NIFLSG+NXXZSG>>/PAGSIZ
ALCORE==ALCORX+<MAXFFS+MAXFFX+MAXFFL+MAXFFB+MAXFFY+MAXFFA+PAGSIZ-1>/PAGSIZ
]	;END IFN PAGING
.ELSE [
ALCORX==<BBPSSG-FIRSTLOC+STDLO-SEGSIZ*<NIFSSG+NIFXSG+NIFLSG+NXXZSG>>/PAGSIZ
ALCORE==ALCORX+4
]

ALLOCC:
PG%	ALLHACK ASBPS,#,BPS,ALBPS,ENDLISP-BBPSSG,,BPSH
	ALLHACK ASRPDL,#,REGPDL,ALPDL,200,100,OC2
	ALLHACK ASSPDL,#,SPECPDL,ALSPDL,200,100,OSC2
	ALLHACK ASFXP,#,FXPDL,ALFXP,200,LSWS+12,OFXC2
	ALLHACK ASFLP,#,FLPDL,ALFLP,10,10,OFLC2
10$	ALLHACK ASDDT,#,DDTSYMS,100,20,,SYMLO
	ALLHACK ASLIST,,LIST,MAXFFS,200,,XFFS
	ALLHACK ASSYM,,SYMBOL,MAXFFY,200,,XFFY
	ALLHACK ASFIX,,FIXNUM,MAXFFX,200,,XFFX
	ALLHACK ASFLO,,FLONUM,MAXFFL,200,,XFFL
IFN BIGNUM,	ALLHACK ASBIG,,BIGNUM,MAXFFB,100,,XFFB
	ALLHACK ASARY,,ARRAY,MAXFFA,100,,XFFA
	PUSHJ P,ALLTYO
	ASCIZ \
\


SUBTTL	RUNTIME STORAGE ALLOCATION

	MOVEI TT,ALCORX*PAGSIZ
IRP Q,,[S,X,L,B,Y,A]Z,,[FS,FX,FL,BN,SY,SA]N,,[NIFSSG+2,NIFXSG+2
NIFLSG+1,NBNSG,NSYMSG+1,NSARSG]FLG,,[1,1,1,BIGNUM,1,1]
IFN FLG,[
	MOVEI T,<N>*SEGSIZ
	CAML T,XFF!Q
	MOVEM T,XFF!Q
	MOVE T,XFF!Q
	CAMGE T,G!Z!SIZ
	MOVEM T,G!Z!SIZ
	ADD TT,T
	LSH T,-4	;HACK
	CAIGE T,SEGSIZ
	MOVEI T,SEGSIZ
	CAILE T,4000
	MOVEI T,4000
	CAML T,G!Z!SIZ
	SUBM T,G!Z!SIZ
]		;END OF IFN FLG
TERMIN
	MOVEI D,ALCORE
	SUB D,TT
	JUMPLE D,ALLCZX
IRP Q,,[S,X,L,Y]%%%,,[70.,15.,3.,12.]
	MOVEI T,(D)
	IMULI T,%%%
	IDIVI T,100.
	ADDM T,XFF!Q
TERMIN
ALLCZX==.

;FALLS THROUGH


;FALLS IN

IFN PAGING,[

ALLCPD:	SETZ F,
	MOVEI R,MEMORY-NSCRSG*SEGSIZ
IRP Q,,[SC2,C2,FLC2,FXC2]Y,,[1,0,0,0]W,,[SPDL,PDL,FLP,FXP]
	MOVEI T,(R)
	SUBI T,MIN!W
	EXCH T,O!Q
	CAIGE T,MIN!W
	MOVEI T,MIN!W
	MOVEM T,X!W
	ADDI T,PAGSIZ-1+MIN!W
	ANDI T,PAGMSK
	MOVEI TT,(T)
	LSH TT,-PAGLOG
	SUBI F,(TT)
	SUBI R,(T)
	MOVEI D,PAGSIZ-20
	CAML D,X!W
	MOVE D,X!W
	MOVNS D
	HRLS D
	HRRI D,(R)
IFN <Y>,	ADD D,R70+Y
	MOVEM D,Q
	MOVEI D,(R)
	ADD D,X!W
	ANDI D,777760	;KEEP AWAY FROM PAGE BOUNDARIES!
	TRNN D,PAGKSM
	SUBI D,20
	MOVEM D,X!W
	MOVEM D,Z!W
TERMIN
	HRLM F,PDLFL1
	IMULI F,SGS%PG
	HRLM F,PDLFL2
	MOVEI F,(R)
	LSH F,-PAGLOG
	HRRM F,PDLFL1
	MOVEI F,(R)
	LSH F,-SEGLOG
	HRRM F,PDLFL2
	SUBI R,1
	MOVEM R,HINXM
	HRRZ A,SC2
	MOVEM A,ZSC2
	HRRZ A,C2
	ADDI A,1
	MOVEM A,NPDLH
	HRRZ A,FXC2
	ADDI A,1
	MOVEM A,NPDLL
IT%	SETZM SYMLO
	JRST ALLDONE

]		;END OF IFN PAGING


;FALLS IN

IFE PAGING,[

ALLCPD:	MOVEI A,BFXPSG
	MOVEM A,NPDLL
	MOVEI B,LOFXPDL		;SET UP FXP
	ADD B,OFXC2
	ADDI B,SEGSIZ-1
	ANDI B,SEGMSK
	MOVNI C,-LOFXPDL(B)
	MOVSI C,(C)
	HRRI C,-1(A)
	MOVEM C,FXC2
	ADDI C,-LOFXPDL(B)
	HRLI C,-LOFXPDL
	MOVEM C,OFXC2
	MOVE C,[FX+$PDLNM,,QFIXNUM]
	JSP T,ALSGHK
	MOVEI B,LOFLPDL		;SET UP FLP
	ADD B,OFLC2
	ADDI B,SEGSIZ-1
	ANDI B,SEGMSK
	MOVNI C,-LOFLPDL(B)
	MOVSI C,(C)
	HRRI C,-1(A)
	MOVEM C,FLC2
	ADDI C,-LOFLPDL(B)
	HRLI C,-LOFLPDL
	MOVEM C,OFLC2
	MOVE C,[FL+$PDLNM,,QFLONUM]
	JSP T,ALSGHK
	MOVEM A,NPDLH
	MOVEI B,LOPDL+LOSPDL+1		;SET UP P AND SP
	ADD B,OC2
	ADD B,OSC2
	MOVEI AR1,SEGSIZ-1(B)
	ANDI AR1,SEGMSK
	MOVEI AR2A,(AR1)
	MOVEI F,(A)
	SUBI AR1,(B)
	LSH AR1,-1			;SPLIT SEGMENT REMAINDER
	MOVE B,OC2
	ADDI B,LOPDL(AR1)
	MOVNI C,-LOPDL(B)
	MOVSI C,(C)
	HRRI C,-1(A)
	MOVEM C,C2
	ADDI C,-LOPDL(B)
	HRLI C,-LOPDL
	MOVEM C,OC2
	ADDI A,(B)
	MOVE B,OSC2
	ADDI B,LOSPDL+1(AR1)
	MOVNI C,-LOSPDL-1(B)
	MOVSI C,(C)
	HRRI C,(A)	.SEE UBD	;SP NEEDS FUNNY SLOT
	MOVEM C,SC2
	HRRZM C,ZSC2
	ADDI C,-LOSPDL-1(B)
	HRLI C,-LOSPDL
	MOVEM C,OSC2
	MOVEI A,(F)
	MOVEI B,(AR2A)
	MOVE C,[$XM,,QRANDOM]
	JSP T,ALSGHK
	MOVEM A,BPSL
	MOVEM A,VBP1
	MOVE C,A
	ADDB C,BPSH		;FIRST ESTIMATE OF BPSH
	HRRE B,.JBSYM
	JUMPLE B,ALCPD1		;ONLY HACK SYMBOLS IF IN LOW SEGMENT
	SUB B,SYMLO
	CAIG C,(B)
	MOVE C,B
	MOVEM C,BPSH		;SECOND ESTIMATE OF BPSH
	ADD C,SYMLO
	HLRE B,.JBSYM"
	HRRO D,.JBSYM
	SUB D,B
	SUBI D,1			;TO BE A PDL PTR IN THE SYMMOV
	SUB C,B
ALCPD1:	IORI C,SEGKSM			;HIGHEST ADDR FOR AUGMENTED SYMTAB
	MOVEI B,1(C)
	CAMG C,.JBFF
	 JRST .+3
	CORE C,
	 JRST ALQX2
	HRRM B,.JBFF"
	MOVEI F,-1(B)
	SUB B,BPSL		;TOTAL NUMBER WDS OCCUPIED BY RANDOM BPS AND SYMTAB
	SUBI F,(D)		;TOTAL DISTANCE THAT SYMTAB MOVES
	HRRE R,.JBSYM
	JUMPLE R,ALQX1		;ONLY HACK SYMBOLS IF THERE OR IN LOW SEGMENT
	HLRE R,.JBSYM
	JUMPE F,ALQX1
	MOVE TT,[SYMMOV,,SYMMV1]
	BLT TT,LPROGS
	HRRI SYMMV1,(F)
	JRST SYMMV1
SYMMV6:	ADDI SYMMV1,1(D)
	HRRM SYMMV1,.JBSYM"
	SUB SYMMV1,SYMLO
	SUBI SYMMV1,1
	HRRZM SYMMV1,BPSH			;IF THERE WAS A SYMTAB, NOW WE KNOW WHERE BPSH IS
IFE SAIL,[
	MOVE F,[112,,11]
	GETTAB F,
	 SETZ F,
	LDB F,[061400,,A]
	CAIN F,3
	 HRRM SYMMV1,@770001	;TENEX SIMULATOR FOR TOPS-10
]		;END OF IFE SAIL
ALQX1:	MOVE C,SYMLO
	ASH C,-1
	MOVEM SYMLO		;CONVERT FROM # OF WORDS TO  # OF ENTRIES
	HRRZ C,BPSH
	SUB C,IGCFX1		;IF NEWIO, MUST ALLOW FOR INITIAL ARRAY
	SUB C,IGCFX2		;AND INIT FILE ARRAY
	MOVEM C,VBPE1		;INITIAL SETTING OF BPEND
	MOVE C,[$XM,,QRANDOM]
	JSP T,ALSGHK
	MOVEI C,-1(A)
	MOVEM C,HIXM
	MOVEI B,HILOC
	ANDI B,SEGMSK
	SUBI B,(A)
	MOVE C,[$NXM,,QRANDOM]
	JSP T,ALSGHK
	JRST ALLDONE

ALSGHK:	MOVEI TT,(A)
	MOVNI D,(B)
	LSH TT,-SEGLOG
	ASH D,-SEGLOG
	HRLI TT,(D)
	MOVEM C,ST(TT)
	AOBJN TT,.-1
	ADDI A,(B)
	JRST (T)

ALQX2:	PUSHJ P,ALLTYO
	ASCIZ \
CAN'T GET ENOUGH CORE!\
	JRST ALLOC1
]		;END OF IFE PAGING



ALLDONE:
IFE PAGING,[
IFE SAIL,[
	MOVE P,C2		;SET UP PDL POINTERS
	MOVE FXP,FXC2
	MOVE FLP,FLC2
	MOVE SP,SC2
]	;END OF IFE SAIL
]		;END OF IFE PAGING
	MOVEI A,LISP
	HRRM A,LISPSW
	SETZM ALGCF		;GC IS OKAY NOW
IFN D10,[
	MOVEI A,GOINIT
	HRRM A,.JBSA"
	PUSHJ P,GRELAR
]	;END OF IFN D10
	JRST LISP

CONSTANTS	;ALLOC'S LITERALS GET EXPANDED HERE

IFE PAGING,[

SYMMOV:			;MOVE MOBY JOB SYMBOL TABLE UPWARDS
OFFSET C-.
SYMMV1:	POP D,.(D)	;C
	AOJL R,SYMMV1	;AR1
	JRST SYMMV6	;AR2A
LPROGS==.-1
OFFSET 0
.HKILL SYMMV1

]		;END OF IFE PAGING




;;; INITIAL ARRAYS IN SYSTEM GO HERE.
	.SEE GCMKL
	.SEE IGCMKL
	.SEE VBPE1


SUBTTL	INITIAL INIT FILE ARRAY FOR .LISP. (INIT) FILE

	-F.GC,,INIIF2		;GC AOBJN POINTER
INIIF1:	JSP TT,1DIMS
		INIIFA		;POINTER TO SAR
		0		;CAN'T ACCESS
INIIF2:
OFFSET -.
	FI.EOF::	NIL		;EOF FUNCTION
	FI.BBC::	0,,NIL		;BUFFERED BACK CHARS
	FI.BBF::	NIL		;BUFFERED BACK FORMS
			BLOCK 5
	F.MODE::	0		;MODE (BLOCK ASCII DSK INPUT)
	F.CHAN::	-1		;CHANNEL # (INITIALLY ILLEGAL)
	20$ F.JFN::	-1		;JOB-FILE NUMBER
	20%		0
	F.FLEN::	0		;FILE LENGTH
	F.FPOS::	-1		;FILEPOS
			BLOCK 3
IFN ITS+D10,[
	F.DEV::		SIXBIT \DSK\	;DEVICE
IT$	F.SNM::		0		;SNAME (FILLED IN)
10$	F.PPN::		0		;PPN (FILLED IN)
IT$	F.FN1::		SIXBIT \.LISP.\	;FILE NAME 1
10$	F.FN1::		SIXBIT \LISP\
IT$	F.FN2::		SIXBIT \(INIT)\	;FILE NAME 2
10$	F.FN2::		SIXBIT \INI\
	F.RDEV::	BLOCK 4		;.RCHST'D NAMES
]		;END OF IFN ITS+D10
IFN D20,[
	F.DEV::		ASCIZ \DSK\	;DEVICE (FILLED IN AT RUN TIME)
		BLOCK L.6DEV-<.-F.DEV>
	F.DIR::				;DIRECTORY (UNSPECIFIED)
		BLOCK L.6DIR-<.-F.DIR>
	F.FNM::		ASCIZ \LISP\	;FILE NAME
		BLOCK L.6FNM-<.-F.FNM>
	F.EXT::		ASCIZ \INI\	;EXTENSION
		BLOCK L.6EXT-<.-F.EXT>
	F.VRS::		ASCIZ \0\	;VERSION
		BLOCK L.6VRS-<.-F.VRS>
]		;END OF IFN D20
LOC INIIF2+LOPOFA
		BLOCK 5
	AT.CHS::	0		;CHARPOS
	AT.LNN::	0		;LINENUM
	AT.PGN::	0		;PAGENUM
		BLOCK 10
LONBFA::
	FB.BYT::	0		;BYTE SIZE
	FB.BFL::	0		;BUFFER LENGTH
	FB.BVC::	0		;COUNT OF VALID CHARACTERS
IFN ITS+D20,[
	FB.IBP::	0		;INITIAL BYTE POINTER
	FB.BP::		0		;BYTE POINTER
	FB.CNT::	0		;CHARACTER COUNT
		BLOCK 2
]		;END OF IFN ITS+D20
IFN D10,[
	FB.HED::	0		;BUFFER HEADER
	FB.NBF::	0		;NUMBER OF BUFFERS
	FB.BWS::	0		;SIZE OF BUFFER IN WORDS
SA%		0
SA$	FB.ROF::	0		;RECORD OFFSET
		BLOCK 1
]		;END OF IFN D10
	FB.BUF::
10%			BLOCK RBFSIZ
10$			BLOCK NIOBFS*<LIOBUF+3>
10$ IFL NIOBFS-2,	BLOCK NIOBFS*<LIOBUF+3>

OFFSET 0
LINIFA==:.-INIIF1+1		;TOTAL NUMBER OF WORDS
EINIFA::			;END OF ARRAY
	-1			;PHOOEY! FORCE THE "BLOCK" TO MAKE REAL 0'S